#!/usr/bin/perl
# $Id$
#
# Description: PGP Signature path tracing
#
# Copyright (C) 2003,2004,2005,2006 Charles Mauch <cmauch@gmail.com>
#               2001 Darxus <Darxus@ChaosReigns.com>
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
# Street, Fifth Floor, Boston, MA  02110-1301, USA.
#
# -- [ meta information ] ----------------------------------------------------
#
# Traces a gpg signature path from one ID to another.  To use this script,
# you need the source and destination key's in your keyring.  If you want to
# generate your own databases, you'll need all keyrings (worldwide) to
# generate a complete path between the two. (generally)  You can find
# current keyserver dumps by googling for "keyserver dump" in the  the
# sks-devel list.
#
# GnuPG has real problems handling the keyrings generated by sks.  There are
# a lot of bad/corrupted keys and GnuPG tends to puke on them.  GnuPG also
# takes a long time, so I suggest using pgpring (bundled with mutt) to
# export key signatures.  The process I used looks something like:
#
# -- [ start import.sh ] -----------------------------------------------------
# #!/bin/sh
# FILES=`ls ~/.gnupg/keydump/*.pgp`
# rm ~/.gnupg/world.sigs
#
# for keys in $FILES; do
#   echo -n "Exporting Signatures for $keys ... "
#   /usr/lib/mutt/pgpring -k $keys -S -5 >> ~/.gnupg/world.sigs
#   echo "DONE"
# done
#
# echo "Importing Signatures into Sigtrace Signature Database ..."
# cat ~/.gnupg/world.sigs | ~/sigtrace.pl 81EB03EC6356B7B8 564323F3FCA6604B
# echo "Importing Signatures into Sigtrace Keynames Database ..."
# cat ~/.gnupg/world.sigs | ~/keynames.pl
# -- [ end import.sh ] -------------------------------------------------------
#
# Now try it out.  Use the long key id's generated by gpg:
#
# gpg --with-colons --list-keys "Charles Mauch (Key-Signing-Key)"
# tru::0:1120431292:1136104964
# pub:u:1024:17:81EB03EC6356B7B8:2005-06-27:::u:Charles Mauch (Key-Signing-Key) <cmauch@gmail.com>::scSC:
#
# and of course the recipient's id:
#
# gpg --with-colons --list-keys "RichardStallman"
# tru::0:1120431292:1136104964
# pub:-:1024:17:624DC565135EA668:2001-03-05:::-:Richard Stallman (Chief GNUisance) <rms@gnu.org>::scESC:
#
# Now take what we learned and feed it into sigtrace.
#
# ~/sigtrace.pl 81EB03EC6356B7B8 624DC565135EA668
# Data loaded, tracing....
# level:0 keys:1 seconds:0
# level:1 keys:3 seconds:0
# level:2 keys:15 seconds:0
# level:3 keys:19 seconds:0
# 4 hop path: 81EB03EC6356B7B8 EF14CF65B9060243 96B0C3697B33D4A1
# 56B0315F0167CA38 624DC565135EA668
# 81EB03EC6356B7B8 Charles Mauch (Key-Signing-Key) <cmauch@gmail.com>
# EF14CF65B9060243 Charles Mauch <cmauch@gmail.com>
# 96B0C3697B33D4A1 Patrick Ryan <signing@pryan.org>
# 56B0315F0167CA38 Seth David Schoen <schoen@eff.org>
# 624DC565135EA668 Richard Stallman (Chief GNUisance) <rms@gnu.org>
#
# It's much quicker to download signed.db and keynames.db precompiled than
# to generate the databases yourself.  It took me a good 18 hours to compile
# signed.db on my Athlon XP 2800 / 512 Meg Ram.  Keynames.db only took about
# 2 hours to compile.  If you are going to generate your own database, be
# sure to look below for the section called "signature database generation"
# and remove the comments.
#
# If you want to keep things simple and only generate paths between people
# you know, you can keep your keyring up to date with something like this:
#
# gpg --no-default-keyring --keyring mykeyring.gpg --recv-keys `gpg  --no-default-keyring --keyring mykeyring.gpg --list-sigs | grep 'User id not found' | cut -c12-20 | sort -u | tr "\012" " "`
#
# -- [ changelog ] -----------------------------------------------------------
#
# v0.8 Nov 21 21:29 EDT print # of hops while searching
# v0.9 Nov 21 21:49 EDT cleaned up output
# v0.10 Nov 21 21:57 EDT print # of keys checked
# v0.11 Nov 21 22:57 EDT a bunch of comments
# v0.12 Nov 22 16:44 EDT display # of keys at each level
# v0.17 Nov 27 18:14 EDT buncha stuff, including 25,000% speed increase
#                        (literally, hashes rock)
# v0.18 Nov 27 19:34 EDT modified to use MCTs .db
# v0.19 Nov 27 20:06 EDT stop if no more keys
# v0.20 Nov 27 20:30 EDT test children, not parents - speed up
# v0.21 Nov 29 20:59 EDT added path caching
# v0.22 Nov 29 21:37 EDT name lookups if keynames.db is present
# v0.23 Nov 30 06:27 EDT handle multiple destinations
# v0.24 Jul 31 15:02 EDT fixed delimiter in commented out import code
#                         - changed from "," to " ".
# v0.30 Jul 3  15:51 PST converted script to use gnupg's --with-colons
#                        output (cmauch)
# v0.31 Jul 4  12:03 PST should now drop revoked signatures (cmauch)
# v0.32 Jul 5  17:28 PST tweaked documentation
#
# -- [ BUGS ] ----------------------------------------------------------------
# * there is no conversion between short and long key ids.  I handle this
#   with mutt-sigtrace.pl
#
#

use DB_File;

$alpha = shift @ARGV;    # start at this key
for $end ( @ARGV ) {
    $omega{ $end } = 1;
}

tie %path, "DB_File", ".paths.db" or die "Could not tie to file: $!\n";

for $child ( keys %omega ) {
    if ( $path{ "$alpha $child" } ) {
        print "(cached $alpha to $child)\n$path{\"$alpha $child\"}\n";
        &namelookup;
        delete $omega{ $child };
    }
}

untie %path;

#print join(' ',keys %omega);
exit 0 if ( scalar( keys %omega ) < 1 );

#my (%signedby);
tie %signedby, "DB_File", ".signed.db" or die "Could not tie to file: $!\n";

# don't line buffer
$pipe = $|;
$|    = 1;

# $keyring = $ARGV[2]; # use this keyring to print the names in the path
$level     = 0;
$levelkeys = 0;

# -- [ signature database generation ] ---------------------------------------
#
# Load all signature relationships into a hash of arrays, called %signedby.
# Each key is the ID of someone who signed keys, and its value is an array
# containing a list of the IDs he signed.  You'll need to uncomment the
# following if you want to build your own signature database.
#
# For details on what the fields are with gpg colon-output, see the file
# DETAILS in the gnupg doc directory (/usr/share/doc/gnupg/DETAILS.gz)
#

#while ($line = <STDIN>)
#{
#  chomp $line;
#  ($type,undef,undef,undef,$id,undef,undef,undef,undef,undef,undef,undef,undef,undef) = split(':',$line);
#
#  # Skip if key is revoked
#  next if ($type eq 'rev');
#
#  if ($type eq "pub") { $pub = $id; }
#
#  if ($type eq "sig")
#  {
#    next if ($id eq $pub);
#    #push (@{$signedby{$id}},$pub);
#    $signedby{$id} .= "$pub ";
#  }
#}

print "Data loaded, tracing....\n";

# Load the beginning key into the queue.
# The queue data is in pairs.  The 1st value is the ID to be tested, the 2nd
# value is the path to get from the origin to that ID.
# The original path is null, because.. it's at the beginning.
#
# A pair of nulls is used to delimit the boundaries between levels of recursion
# (# of hops).

push( @queue, $alpha, "", "", "" );

# Loop through the queue till it's empty.
# This is a depth-first search.

print "level:0";

$lasttime = time;
while ( @queue ) {
    $id   = shift @queue;
    $path = shift @queue;

    # If a recursion level boundary is hit, report it.
    if ( $id eq "" ) {
        $level++;
        if ( $levelkeys == 0 ) {
            print " keys:$levelkeys seconds:" . scalar( time - $lasttime ) . "\nNo path found to: " . join( " ", keys( %omega ) ) . "\n";
            untie %signedby;
            tie %path, "DB_File", ".paths.db" or die "Could not tie to file: $!\n";
            for $end ( keys %omega ) {
                $path{ "$alpha $end" } = "No path found";
            }
            exit 1;
        } ## end if ( $levelkeys == 0 )
        print " keys:$levelkeys seconds:" . scalar( time - $lasttime ) . "\nlevel:$level";
        $lasttime  = time;
        $levelkeys = 0;

        # Mark the next recursion level boundary.
        push( @queue, "", "" );
      next;
    } else {
        $levelkeys++;
    }

    # Put this ID into the list to not check anymore.
    # Is this even used? perl -w whines about it (cmauch)
    $checked{ $id } = 1;

    # If we've come to the end, report it.
    {

        # This ID we just checked was not the destination.
        # Add all its children (IDs this ID signed) to the queue.
        for $child ( split( ' ', $signedby{ $id } ) ) {
            unless ( $queued{ $child } ) {
                if ( $omega{ $child } ) {
                    $| = $pipe;

                    #print " keys:$levelkeys seconds:". scalar(time - $lasttime) ."\nlevel:". scalar($level+1) ."\n";
                    print " keys:$levelkeys seconds:" . scalar( time - $lasttime ) . "\n";
                    $output = scalar( $level + 1 ) . " hop path:$path $id $child";

                    #untie %signedby;
                    tie %path, "DB_File", ".paths.db" or die "Could not tie to file: $!\n";
                    $path{ "$alpha $child" } = $output;
                    print "$output\n";
                    &namelookup;
                    delete $omega{ $child };
                    untie %path;
                    exit 0 if ( scalar( keys %omega ) < 1 );
                    print "level $level";
                } ## end if ( $omega{ $child } )
                push( @queue, $child, "$path $id" );
                $queued{ $child } = 1;
            } ## end unless ( $queued{ $child })
        } ## end for $child ( split( ' '...
    }
} ## end while ( @queue )

sub namelookup {
    if ( -e ".keynames.db" ) {
        tie %name, "DB_File", ".keynames.db" or die "Could not tie to file: $!\n";
        $output = ( split( ":", $path{ "$alpha $child" }, 2 ) )[1];
        for $key ( split( " ", $output ) ) {
            print "$key $name{$key}\n" unless ( $key eq " " );
        }
    }
} ## end sub namelookup
